perm filename FILLER.XLD[MSS,LCS] blob sn#097565 filedate 1974-04-06 generic text, type T, neo UTF8
00005	C  Q AND R  ARE X,Y COORDS.  NE(1)=WDCNT. OTHER NE'S HAVE 3
00007	C   FOR INVIS. VECTORS.   M=VERTICAL SCAN LINES
00010		SUBROUTINE FILLER(Q,R,NE,M)
00200		DIMENSION Q(1),R(2),NE(1)
00300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00500		KK=NE(1)
00600		KJ=2
00700		DO 4 K=2,KK
00800		IF(NE(K).NE.3)GO TO 11
00900		NE(K)=KJ
01000		KJ=K+1
01100		GO TO 4
01200	11	NE(K)=0
01300	4	CONTINUE
01310		DO 12 K=1,KK
01320		Q(K)=IFIX(Q(K))
01330	12	R(K)=IFIX(R(K))
01400		NE(KK+1)=KJ
01500	C  FINDS JUMPS
02200		DO 2 J=2,KK
02300		IF(NE(J).GT.0.OR.Q(J).EQ.Q(J-1))GO TO 2
02400	C  SKIPS VERTICAL LINES
02410		X=HALF(Q,J)+.00001
02500	C  MIDPOINT OF LINE
02600		ALT=HALF(R,J)
02700	C  THE ALTITUDE
02800		KJ=0
02810	
02900	100	DO 3 L=2,KK
03000		IF(L.EQ.J.OR.NE(L).GT.0)GO TO 3
03100	C  NEXT FINDS LINE OVERLAP
03200	CC	IF(MISS(L,X,Q,R))3,40,5
03205		IF(MISS(L,X,Q,R))3,40,40
03210	CC5	IF(Q(L).EQ.Q(L-1))GO TO 40
03300	CC	IF(POINT(L,Q,R,NE))GO TO 3
03800	C  NEXT FINDS ALT. OF CROSSING
03900	40	Y=HGHT(L,X,Q,R)
04000		IF(Y.LT.ALT)KJ=KJ+1
04100	3	CONTINUE
04200		IF(MOD(KJ,2).EQ.0)GO TO 2
04300	C  FOUND A LINE TO DRAW LINES DOWN FROM.
04400		NE(J)=-1
05110	CC	X=-1
05215		KJ=M
05235		N=Q(J)
05255		L=Q(J-1)
05260		IF(N.LT.L)GO TO 33
05262		KJ=-KJ
05264		N=N-1
05266		GO TO 34
05270	33	N=N+1
05295	34	JA=3
05297	CC	X=-1
05299	
05300	17	DO 6 K=N,L,KJ
05310		RK=K
05501		Y=HGHT(J,RK,Q,R)
05610		CALL LINES(RK,Y,JA)
05611	CC	IF(X)CALL LINES(RK,Y,JA)
05620		JA=2
05700		H=-10000
05800	
05900	18	DO 7 I=2,KK
06000		IF(NE(I).NE.0)GO TO 7
06100	C  SKIP IF SAME LINE.
06200		IF(MISS(I,RK,Q,R))GO TO 7
06400	C  TRY NEXT POINT IF IT HIT A -1 LINE.
07001	9	B=HGHT(I,RK,Q,R)
07100		IF(B.GT.Y)GO TO 7
07200		IF(B.LE.H)GO TO 7
07300		H=B
07500	C  FOUND HIGHEST NEW POINT
07510	CC	IX=I
07600	7	CONTINUE
07700		IF(H.EQ.Y)GO TO 31
07800	C  WIPES OUT THIS LINE SEG.
08200		IF(H.NE.-10000)GO TO 31
08300	CC	X=1
08305		GO TO 6
08306	CC31	IF(X)GO TO 32
08308	CC	IF(JX.NE.IX)JA=3
08310	CC32	CALL LINES(RK,H,JA)
08311	31	CALL LINES(RK,H,2)
08312	CC	JA=2
08314	CC	JX=IX
08320	CC	IF(X.GT.0)CALL LINES(RK,Y,JA)
08330	CC302	X=-X
08500	6	CONTINUE
08505		IF(JA.EQ.3.OR.K.EQ.L)GO TO 2
08507		IF(H.NE.-10000)CALL LINES(FLOAT(L),HGHT(J,FLOAT(L),Q,R),2)
08510	2	CONTINUE
08600	
08700	301	IF(IPLT.EQ.0)CALL DPYOUT(1)
12000		END
13000		
13100		FUNCTION HGHT(J,A,Q,R)
13110		DIMENSION Q(1),R(1)
13120		B=R(J-1)
13130		D=Q(J-1)
13140		F=Q(J)
13200		HGHT=((R(J)-B)*(A-D))/(F-D)+B
13250		IF(A.EQ.D)HGHT=B
13300		END
13400	
13500	CC	FUNCTION POINT(L,Q,R,NE)
13510	CC	DIMENSION Q(1),R(1),NE(1)
13600	CC	K=L-1
13700	CC	N=L+1
13800	CC	IF(NE(N).GT.0)N=NE(N)
13900	CC	IF(NE(K).GT.0)K=NE(K)
14000	CC	POINT=0
14100	CC	A=Q(N)
14200	CC	B=Q(K)
14300	CC	C=Q(L)
14400	CC	IF((B.GE.C.AND.A.GE.C).OR.(B.LE.C.AND.A.LE.C))POINT=-1
14500	CC	END
14600	
14700		FUNCTION MISS(J,A,Q,R)
14800		DIMENSION Q(1),R(1)
14900		B=Q(J)
15000		C=Q(J-1)
15100		MISS=0
15200		IF(B.GT.A)GO TO 1
15300		IF(B.NE.A)GO TO 2
15400		MISS=1
15500		RETURN
15600	2	IF(C.LE.A)GO TO 3
15700		RETURN
15800	1	IF(C.LT.A)RETURN
15900	3	MISS=-1
16000		END
16100	C  MISS=-1, HIT=0, POINT=1
16200	
16300		FUNCTION HALF(A,J)
16400		DIMENSION A(1)
16500		HALF=(A(J-1)-A(J))/2.+A(J)
16600		RETURN
16700